home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / mfloat.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-21  |  5.9 KB  |  161 lines
  1. PROGRAM MemFloat;
  2.  
  3. Uses WinTypes, WinProcs, WObjects;
  4.  
  5. {$D MemFloat, Copyright (c) 1991 by Chris P. Thornton, based on: }
  6. {$D Floater, Copyright (c) 1991 by Neil J. Rubenking}
  7. {$D Contributions from: Kurt B. Barthelmess }
  8. {$D Contributions from: Craig Boyd          }
  9. {$D Contributions from: Tony Vitabile       }
  10.  
  11. {At long last, this is the result of the "Window On Top" thread that ran in
  12.  mid December 1991.  I needed an example of a window that would keep itself
  13.  on top of other windows.  Craig Boyd pulled up an example that Neil Rubenking
  14.  has posted back in September (I guess I still had my nose buried in the
  15.  "Cookbook" back then.)
  16.  It worked by checking to see whether or not its window had the input focus.
  17.  If not, then it moved itself to the top, without stealing the input focus.
  18.  This solution did what it was supposed to do, but could sometimes cause a
  19.  "twinkling" effect as it repainted itself repeatedly.  It couldn't tell that
  20.  it was already on top of all of the other windows.
  21.  
  22.  Tony Vitabile had sent me a note to check into the SetWindowPos() function,
  23.  as an alternative.
  24.  
  25.  I was able to get both of these solutions to work, but I still needed to find
  26.  a way to determine whether the windows really needed painting or not.  Finally,
  27.  Kurt B. Barthelmess came to my rescue with the following:
  28.        if GetWindow(HWindow, gw_HWndPrev) <> 0 then
  29.          SetWindowPos(HWindow, 0, 0, 0, 0, 0,
  30.             swp_NoMove or swp_NoSize or swp_NoActivate);
  31.  This checks the position (in the Z-Order), and then re-positions only if
  32.  necessary.
  33.  
  34.  As Kurt pointed out, you need to make sure that you are not in contention with
  35.  another app.  If multiple apps are trying to stay on top, they will hog the
  36.  system, and twinkle like crazy!
  37.  Also, I have found that any app employing this technique will defeat any
  38.  screen saver that I've come accross.  If anyone can find a way to detect that,
  39.  please add to this program!
  40.  
  41.  Lastly, I decided that in order to justify my re-posting of this compilation
  42.  of other people's work, I needed to add something of value.
  43.  As I was struggling with heap storage at the time that I was going through this
  44.  excercise, I made a little memory detective out of it.  It will display
  45.  MaxAvail - largest contiguous heap block available, as well as
  46.  MemAvail - Total heap available.
  47.  I keep the previous values around for the next timer tick, so that I don't
  48.  re-display, unless it's necessary.
  49.  I added a wm_Size method, to display the values in dynamically-sized edit windows.
  50.  
  51.  Again, I would like to thank everyone that participated in the "Windows On Top"
  52.  thread.  There's NO WAY that I could have figured this out on my own.
  53.  Chris Thornton
  54.  }
  55.  
  56.  
  57. CONST
  58.   AppName : PChar = 'MemFloat';
  59.   MyTimer = 1;
  60.  
  61. TYPE
  62.   TMyApplication = object(TApplication)
  63.     PROCEDURE InitMainWindow; virtual;
  64.   END;
  65.  
  66.   PTestWindow = ^TTestWindow;
  67.   TTestWindow = OBJECT(TWindow)
  68.     oldmaxavail : LongInt;      {previous value}
  69.     oldMemavail : LongInt;
  70.     MaxEdit : PEdit;          {edit box to display in}
  71.     MemEdit : PEdit;
  72.     CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
  73.     DESTRUCTOR Done; Virtual;
  74.     PROCEDURE SetUpWindow; Virtual;
  75.     PROCEDURE wmsize(var Message: TMessage); virtual wm_first + wm_Size;
  76.     FUNCTION GetClassName : PChar; Virtual;
  77.     PROCEDURE wmTimer(VAR Msg : TMessage); Virtual
  78.       wm_First + wm_Timer;
  79.   END;
  80.  
  81. PROCEDURE TTestWindow.wmTimer;
  82. var dtext : array[0..10] of Char;
  83.   BEGIN
  84.     if GetWindow(HWindow, gw_HWndPrev) <> 0 then
  85.          SetWindowPos(HWindow, 0, 0, 0, 0, 0,
  86.             swp_NoMove or swp_NoSize or swp_NoActivate);
  87.             {This looks to see if your window is at the top of the Z-order.
  88.              If not, then it puts you there, without moving, sizing, or
  89.              activating yourself.}
  90.     
  91.     { Now, to make this app useful, report MaxAvail and MemAvail }
  92.     if (MaxAvail <> OldMaxAvail) or (MemAvail <> OldMemAvail) then
  93.     begin                   {re-display figures only when they have actually changed}
  94.       OldMaxAvail := MaxAvail;  {save for next time around...}
  95.       OldMemAvail := MemAvail;
  96.       Str(OldMaxAvail,dtext);
  97.       MaxEdit^.SetText(dtext);  {display}
  98.       Str(MemAvail,Dtext);
  99.       MemEdit^.SetText(dtext);
  100.     end;
  101.   END;
  102.  
  103. CONSTRUCTOR TTestWindow.Init;
  104.   BEGIN
  105.     TWindow.Init(AParent, 'MaxAvail  |  MemAvail');
  106.     Attr.Menu := LoadMenu(hInstance, AppName);
  107.     Attr.Style := Attr.Style AND (NOT ws_MaximizeBox)
  108.                              AND (NOT ws_MinimizeBox);
  109.     Attr.W := 200;
  110.     Attr.H := GetSystemMetrics(sm_CYCaption) + 30;
  111.     MaxEdit := new(PEdit, Init (@Self, 100, '',0,0,0,0,0,False));
  112.     MemEdit := new(PEdit, Init (@Self, 100, '',0,0,0,0,0,False));
  113.   END;
  114.  
  115. PROCEDURE TTestWindow.SetUpWindow;
  116.   BEGIN
  117.     TWIndow.SetUpWindow;
  118.     SetTimer(hWindow, MyTimer, 1000, NIL);
  119.   END;
  120.  
  121.  
  122. {WMSIZE method - dynamically size edit windows to fit within new window}
  123. {MaxEdit is edit box to display MaxAvail.                              }
  124. {MemEdit is edit box to display MemAvail.                              }
  125. {Width of window is Message.LParamLo                                   }
  126. {Height of window is Message.LParamHi                                  }
  127. PROCEDURE TTestWindow.wmsize(var Message: TMessage);
  128.   BEGIN
  129.     TWindow.WMSize(Message);
  130.     SetWindowPos(MaxEdit^.HWindow, 0, 0, 0,
  131.                  (Message.LParamLo div 2),  Message.LParamHi, swp_NoZOrder);
  132.     SetWindowPos(MemEdit^.HWindow, 0, (Message.LParamLo div 2), 0,
  133.                 Message.LParamLo,Message.LParamHi, swp_NoZOrder);
  134.   END;
  135.  
  136. DESTRUCTOR TTestWindow.Done;
  137.   BEGIN
  138.     KillTimer(hWindow, MyTimer);
  139.     TWindow.Done;
  140.   END;
  141.  
  142. FUNCTION TTestWindow.GetClassName;
  143.   BEGIN
  144.     GetClassName := AppName;
  145.   END;
  146.  
  147. PROCEDURE TMyApplication.InitMainWindow;
  148.   BEGIN
  149.     MainWindow := New(PTestWindow, Init(Nil, AppName));
  150.   END;
  151.  
  152. VAR
  153.   MyApp : TMyApplication;
  154.  
  155. BEGIN
  156.   MyApp.Init(AppName);
  157.   MyApp.Run;
  158.   MyApp.Done;
  159. END.
  160.  
  161.